home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / nodes.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-07  |  7.7 KB  |  320 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /* nodes.c: C version of nodes.stl*/
  10. #include "hdr.h"
  11. #include "vars.h"
  12. #include "setprots.h"
  13. #include "nodesprots.h"
  14. #include "miscprots.h"
  15. #include "smiscprots.h"
  16. #include "sspansprots.h"
  17. #include "chapprots.h"
  18.  
  19. /*
  20.  * Tree construction procedures
  21.  *--------------------
  22.  * 2. Lexical elements
  23.  */
  24.  
  25. Node new_instance_node(Tuple value)                        /*;new_instance_node*/
  26. {
  27.     /* construct an instance node used to hold tuples used for instantiations */
  28.  
  29.     Node    node;
  30.  
  31.     node = node_new(as_instance_tuple);
  32.     N_VAL (node) = (char *) value;
  33.     return node;
  34. }
  35.  
  36. Node new_number_node(int value)                            /*;new_number_node*/
  37. {
  38.     /* constructs an number node, used to hold small integer values used for
  39.      * attributes and return statement depth.
  40.      */
  41.  
  42.     Node    node;
  43.  
  44.     node = node_new(as_number);
  45.     N_VAL (node) = (char *) value;
  46.     return node;
  47. }
  48.  
  49. Node new_subtype_decl_node(Symbol type_name)        /*;new_subtype_decl_node*/
  50. {
  51.     Node node;
  52.  
  53.     node         = node_new(as_subtype_decl);
  54.     N_AST1(node) = new_name_node(type_name);
  55.     N_AST2(node) = OPT_NODE;
  56.     return node;
  57. }
  58.  
  59. Node new_name_node(Symbol name)                                /*;new_name_node*/
  60. {
  61.     /* constructs an as_simple_name node. */
  62.  
  63.     Node    node;
  64.  
  65.     node         = node_new(as_simple_name);
  66.     N_UNQ(node) = name;
  67.     return node;
  68. }
  69.  
  70. Node new_attribute_node(int attr, Node arg1, Node arg2, Symbol typ)
  71.                                                         /*;new_attribute_node*/
  72. {
  73.     /* Creates an attribute node. attr is the attribute's name.*/
  74.  
  75.     Node    id_node, attr_node;
  76.  
  77.     id_node         = node_new(as_number);
  78.     N_VAL (id_node)   = (char *) attr;
  79.     attr_node         = node_new(as_attribute);
  80.     N_AST1(attr_node) = id_node;
  81.     N_AST2(attr_node) = arg1;
  82.     N_AST3(attr_node) = arg2;
  83.     N_TYPE(attr_node) = typ;
  84.     return attr_node;
  85. }
  86.  
  87. /*
  88.  *----------------------------------------
  89.  * 4.5 Operators and expression evaluation
  90.  */
  91.  
  92. Node new_unop_node(Symbol oper, Node arg1, Symbol typ)        /*;new_unop_node*/
  93. {
  94.     /* Creates a unary operator node. Oper is the operator's name */
  95.  
  96.     Node    id_node, list_node, node;
  97.  
  98.     id_node = new_name_node(oper);
  99.     list_node = node_new(as_list);
  100.     N_LIST(list_node) = tup_new1((char *) arg1);
  101.     node = node_new(as_un_op);
  102.     N_AST1(node) = id_node;
  103.     N_AST2(node) = list_node;
  104.     N_TYPE(node) = typ;
  105.     return node;
  106. }
  107.  
  108. /* this new procedure has the same functionalities as
  109. new_check_bounds. It defines the tests that have to be performed at
  110. execution time. We have been inspired by what has been done in
  111. chapter 12 for the checking of parameters to generic units */
  112.  
  113. Tuple new_check_disc_node (Symbol type1, Symbol type2) /* new_check_disc_node */
  114. {
  115.     Tuple checks, g_list, a_list, g_discr_map;
  116.     int i;
  117.     Fortup ft;
  118.     Node n, t, d;
  119.     Symbol discr;
  120.  
  121.     checks = tup_new (0);
  122.  
  123.     g_list = discriminant_list(base_type(type1));
  124.     a_list = discriminant_list(base_type(type2));
  125.     g_discr_map = (Tuple) SIGNATURE(type1)[2];
  126.  
  127.     FORTUPI(discr=(Symbol), g_list, i, ft)
  128.         n = node_new(as_check_discr);
  129.         t = new_name_node(type2);
  130.         d = new_name_node((Symbol) a_list[i]);
  131.         N_AST1(n) = discr_map_get(g_discr_map, discr);
  132.         N_AST2(n) = t;
  133.         N_AST3(n) = d;
  134.         checks = tup_with (checks, (char *) n);
  135.     ENDFORTUP(ft);
  136.     return checks;
  137. }
  138.  
  139. Node new_check_bounds_node(Symbol type1, Symbol type2)
  140.                                                     /*;new_check_bounds_node */
  141. {
  142.     /* used to check that component types of array conversions have the same
  143.      * bounds. Should also be used in check_actual_constraint (12c)
  144.      */
  145.  
  146.      Node n, t1, t2;
  147.  
  148.      n  = node_new(as_check_bounds);
  149.      t1 = new_name_node(type1);
  150.      t2 = new_name_node(type2);
  151.      N_AST1(n) = t1;
  152.      N_AST2(n) = t2;
  153.      return n;
  154. }
  155.  
  156. /*
  157.  *------------------------------------------------------------
  158.  * 5.1 Simple and compound statements - Sequence of statements
  159.  */
  160.  
  161. Node new_statements_node(Tuple stmt_list)            /*;new_statements_node*/
  162. {
  163.     /* Creates an as_statements node, given a list (tuple) of statements */
  164.  
  165.     Node    stmt_node, list_node;
  166.  
  167.     stmt_node         = node_new(as_statements);
  168.     list_node         = node_new(as_list);
  169.     N_LIST(list_node) = stmt_list;
  170.     N_AST1(stmt_node) = list_node;
  171.     N_AST2(stmt_node) = OPT_NODE;
  172.     return stmt_node;
  173. }
  174.  
  175. /*
  176.  *-------------------------
  177.  * 5.2 Assignment statement
  178.  */
  179.  
  180. Node new_assign_node(Node lhs, Node rhs)                /*;new_assign_node*/
  181. {
  182.     /* Creates an assign node */
  183.  
  184.     Node    node;
  185.  
  186.     node           = node_new(as_assignment);
  187.     N_AST1(node) = lhs;
  188.     N_AST2(node) = rhs;
  189.     return node;
  190. }
  191.  
  192. /*
  193.  *-----------------
  194.  * 5.3 If statement
  195.  */
  196.  
  197. Node new_call_node(Symbol proc_name, Tuple arg_list, Symbol type_name)
  198.                                                             /*;new_call_node*/
  199. {
  200.     /* Creates a call node.*/
  201.  
  202.     Node    list_node, call_node;
  203.  
  204.     list_node = node_new(as_list);
  205.     N_LIST(list_node) = arg_list;
  206.  
  207.     call_node = node_new(as_call);
  208.     N_TYPE(call_node) = type_name;
  209.     N_AST1(call_node) = new_name_node(proc_name);
  210.     N_AST2(call_node) = list_node;
  211.     return call_node;
  212. }
  213.  
  214. void make_insert_node(Node node, Tuple pre_list, Node post_node)
  215.                                                         /*;make_insert_node*/
  216. {
  217.     /* Transforms node into an insert node */
  218.  
  219.     int nk;
  220.  
  221.     nk = N_KIND(node);
  222.     N_KIND(node) = as_insert;
  223.     N_AST1(node) = post_node;
  224.     if (N_AST2_DEFINED(nk)) N_AST2(node) = (Node)0;
  225.     if (N_AST3_DEFINED(nk)) N_AST3(node) = (Node)0;
  226.     if (N_AST4_DEFINED(nk))  /* copy ast4 if defined */
  227.        N_AST4(node) = (Node)0;
  228.     /* or set n_type if post_node has n_type defined */
  229.     else if (N_TYPE_DEFINED(N_KIND(post_node)))
  230.        N_TYPE(node) = N_TYPE(post_node);
  231.     if (N_VAL_DEFINED(nk)) N_VAL (node) = (char *)0;
  232.     N_LIST(node) = pre_list; /* TBSL: is copy needed  ds 7 nov */
  233. }
  234.  
  235. Node copy_node(Node node)    /*;copy_node*/
  236. {
  237.     Node node2;
  238.  
  239.     node2 = node_new(N_KIND(node));
  240.     copy_attributes(node, node2);
  241.     if (is_terminal_node(N_KIND(node)))
  242.       copy_span(node, node2);/* TBSL: check whether this is always desirable */
  243.     return node2;
  244. }
  245.  
  246. void copy_attributes(Node old, Node newn)                /*;copy_attributes*/
  247. {
  248.     /*  copy attributes of old to new, preserving sequence and unit of new */
  249.  
  250.     char    *np, *op;
  251.     Span    save_span;
  252.     short    terminal;
  253.     int i, n, nseq, nunit;
  254.  
  255.     nseq = N_SEQ(newn);
  256.     nunit = N_UNIT(newn);
  257.     terminal = (is_terminal_node(N_KIND(old)) && is_terminal_node(N_KIND(newn)));
  258.     if (terminal) save_span = get_left_span(newn);
  259.     n = sizeof(Node_s);
  260.     op = (char *)old; np = (char*) newn;
  261.     for (i=1; i <= n; i++) *np++ = *op++;
  262.     N_UNIT(newn) = nunit;
  263.     N_SEQ(newn) = nseq;
  264.     if (terminal) set_span(newn, save_span);
  265. }
  266.  
  267. void copy_span(Node old, Node newn)                            /*;copy_span */
  268. {
  269.     /* retrieve left spans of old node and set spans fields of new node */
  270.     
  271.     Span span;
  272.  
  273.     span = get_left_span(old);
  274.     N_SPAN0(newn) = span->line;
  275.     N_SPAN1(newn) = span->col;
  276.     efreet((char *) span, "spans");
  277. }
  278.  
  279. void set_span(Node node, Span span)                                /*;set_span */
  280. {
  281.     /* set span of node to the values in span */
  282.     N_SPAN0(node) = span->line;
  283.     N_SPAN1(node) = span->col;
  284. }
  285.  
  286. Node copy_tree(Node node)                                        /*;copy_tree*/
  287. {
  288.     /* Create a full copy of the tree rooted at node, and return the new root*/
  289.  
  290.     Fortup    ft1;
  291.     Tuple    tup;
  292.     Node n, root;
  293.     int i;
  294.  
  295.     if (node == (Node)0 || node == OPT_NODE) 
  296.     return (node);
  297.     root = node_new(N_KIND(node));
  298.     N_KIND(root) = N_KIND(node); i = N_KIND(node);
  299.     N_OVERLOADED(root) = N_OVERLOADED(node);
  300.     N_VAL(root) = N_VAL(node);
  301.     N_UNQ(root) = N_UNQ(node);
  302.     N_NAMES(root) = N_NAMES(node);
  303.     N_TYPE(root) = N_TYPE(node);
  304.     N_PTYPES(root) = N_PTYPES(node);
  305.     if (N_AST1_DEFINED(i)) N_AST1(root) = copy_tree(N_AST1(node));
  306.     if (N_AST2_DEFINED(i)) N_AST2(root) = copy_tree(N_AST2(node));
  307.     if (N_AST3_DEFINED(i)) N_AST3(root) = copy_tree(N_AST3(node));
  308.     if (N_AST4_DEFINED(i)) N_AST4(root) = copy_tree(N_AST4(node));
  309.     if (is_terminal_node((unsigned) i)) copy_span(node, root);
  310.  
  311.     if (N_LIST_DEFINED(i) && N_LIST(node) != (Tuple)0) {
  312.     tup = tup_new(tup_size(N_LIST(node)));
  313.     FORTUPI(n=(Node), N_LIST(node), i, ft1);
  314.         tup[i] = (char *) copy_tree(n);
  315.     ENDFORTUP(ft1);
  316.     N_LIST(root) = tup;
  317.     }
  318.     return root;
  319. }
  320.